DEEB Evaluation

truth <- 
  read_csv(params$truthQuantsFile) |> 
  pivot_longer(-c(method, ends_with("Nr")), names_to="loss", values_to="refValue") |> 
  mutate(refValue = ifelse(refValue == 0, 1, refValue))

## Rows: 18 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): method
## dbl (8): taskNr, truthNr, L1, L2, L1AfterTimeWarp, L2AfterTimeWarp, TimeWarp...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

esti <- 
  map(params$estiQuantsFile, read_csv) |> 
  reduce(bind_rows) |> 
  pivot_longer(-c(method, ends_with("Nr")), names_to="loss")

## Rows: 36 Columns: 10
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): method
## dbl (9): truthNr, obsNr, taskNr, L1, L2, L1AfterTimeWarp, L2AfterTimeWarp, T...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

data <- left_join(
  esti, 
  truth |> select(-method), 
  by = c("truthNr", "taskNr", "loss"))

showTable <- function(d, caption) {
  nMethods <- length(unique(d$method))
  d |> 
    select(method, truthNr, value) |>
    pivot_wider(names_from = method, values_from = value) |> 
    kableExtra::kbl(
      digits = 3,
      caption = caption,
      booktabs = TRUE,
      align = c("l", "l", "l", rep("r", nMethods))
    ) |> 
    kableExtra::kable_styling(
      bootstrap_options = c("striped", "condensed"),
      latex_options = c("striped", "HOLD_position"),
      full_width = FALSE)
}

1 Losses

for (tnr in unique(data$taskNr)) {
  cat("## Task", tnr, "\n")
  taskData <- filter(data, taskNr == tnr)
  for (lss in unique(taskData$loss)) {
    cat("### Loss", lss, "\n")
    lssData <- filter(taskData, loss == lss)
    for (onr in unique(lssData$obsNr)) {
      cat("#### ObsNr", onr, "\n")
      obsData <- filter(lssData, obsNr == onr)
      cat(showTable(
        obsData,
        paste0("Task ", tnr, ": ", lss, "-Loss (obsNr: ", onr, ")")))
    }
  }
}

1.1 Task 1

1.1.1 Loss L1

1.1.1.1 ObsNr 1

Task 1: L1-Loss (obsNr: 1)

truthNr	Trivial
1	0.605
2	0.018
3	2.385
4	0.011
5	0.139
6	0.074
7	1.288
8	0.298
9	0.027

1.1.1.2 ObsNr 5

Task 1: L1-Loss (obsNr: 5)

truthNr	Trivial
1	0.361
2	0.099
3	3.215
4	0.177
5	15.473
6	0.217
7	1.680
8	0.388
9	0.337

1.1.2 Loss L2

1.1.2.1 ObsNr 1

Task 1: L2-Loss (obsNr: 1)

truthNr	Trivial
1	0.924
2	0.020
3	3.284
4	0.027
5	0.286
6	0.201
7	2.719
8	0.474
9	0.037

1.1.2.2 ObsNr 5

Task 1: L2-Loss (obsNr: 5)

truthNr	Trivial
1	0.677
2	0.113
3	4.116
4	0.211
5	21.439
6	0.417
7	3.532
8	0.669
9	0.367

1.1.3 Loss L1AfterTimeWarp

1.1.3.1 ObsNr 1

Task 1: L1AfterTimeWarp-Loss (obsNr: 1)

truthNr	Trivial
1	0.059
2	0.008
3	0.329
4	0.004
5	0.079
6	0.079
7	0.135
8	0.155
9	0.004

1.1.3.2 ObsNr 5

Task 1: L1AfterTimeWarp-Loss (obsNr: 5)

truthNr	Trivial
1	0.068
2	0.047
3	1.658
4	0.168
5	5.218
6	0.184
7	0.156
8	0.127
9	0.160

1.1.4 Loss L2AfterTimeWarp

1.1.4.1 ObsNr 1

Task 1: L2AfterTimeWarp-Loss (obsNr: 1)

truthNr	Trivial
1	0.119
2	0.011
3	0.608
4	0.014
5	0.140
6	0.346
7	0.223
8	0.602
9	0.005

1.1.4.2 ObsNr 5

Task 1: L2AfterTimeWarp-Loss (obsNr: 5)

truthNr	Trivial
1	0.086
2	0.064
3	2.582
4	0.207
5	8.189
6	0.387
7	0.458
8	0.463
9	0.176

1.1.5 Loss TimeWarpCosts

1.1.5.1 ObsNr 1

Task 1: TimeWarpCosts-Loss (obsNr: 1)

truthNr	Trivial
1	18.574
2	3.691
3	69.420
4	2.292
5	0.599
6	11.395
7	7.995
8	4.250
9	7.424

1.1.5.2 ObsNr 5

Task 1: TimeWarpCosts-Loss (obsNr: 5)

truthNr	Trivial
1	11.105
2	27.534
3	322.212
4	211.854
5	69.773
6	94.274
7	9.021
8	5.127
9	418.118

1.1.6 Loss stateDistriW2

1.1.6.1 ObsNr 1

Task 1: stateDistriW2-Loss (obsNr: 1)

truthNr	Trivial
1	0
2	0
3	0
4	0
5	0
6	0
7	0
8	0
9	0

1.1.6.2 ObsNr 5

Task 1: stateDistriW2-Loss (obsNr: 5)

truthNr	Trivial
1	0
2	0
3	0
4	0
5	0
6	0
7	0
8	0
9	0

1.2 Task 2

1.2.1 Loss L1

1.2.1.1 ObsNr 1

Task 2: L1-Loss (obsNr: 1)

truthNr	Trivial
1	0.609
2	1.803
3	2.472
4	1.469
5	0.542
6	1.984
7	7.048
8	2.831
9	0.153

1.2.1.2 ObsNr 5

Task 2: L1-Loss (obsNr: 5)

truthNr	Trivial
1	1.778
2	1.508
3	8.878
4	0.767
5	33.319
6	1.225
7	2.817
8	0.867
9	0.717

1.2.2 Loss L2

1.2.2.1 ObsNr 1

Task 2: L2-Loss (obsNr: 1)

truthNr	Trivial
1	0.952
2	1.974
3	3.143
4	1.641
5	0.857
6	2.174
7	11.016
8	3.495
9	0.160

1.2.2.2 ObsNr 5

Task 2: L2-Loss (obsNr: 5)

truthNr	Trivial
1	2.168
2	1.723
3	9.301
4	1.168
5	36.916
6	1.849
7	5.472
8	1.284
9	0.731

1.2.3 Loss L1AfterTimeWarp

1.2.3.1 ObsNr 1

Task 2: L1AfterTimeWarp-Loss (obsNr: 1)

truthNr	Trivial
1	0.108
2	1.402
3	0.225
4	1.113
5	0.353
6	1.181
7	0.256
8	0.344
9	0.009

1.2.3.2 ObsNr 5

Task 2: L1AfterTimeWarp-Loss (obsNr: 5)

truthNr	Trivial
1	0.082
2	1.185
3	6.253
4	0.764
5	26.386
6	1.123
7	0.245
8	0.124
9	0.501

1.2.4 Loss L2AfterTimeWarp

1.2.4.1 ObsNr 1

Task 2: L2AfterTimeWarp-Loss (obsNr: 1)

truthNr	Trivial
1	0.115
2	1.684
3	0.267
4	1.290
5	2.588
6	1.242
7	0.367
8	0.543
9	0.012

1.2.4.2 ObsNr 5

Task 2: L2AfterTimeWarp-Loss (obsNr: 5)

truthNr	Trivial
1	0.097
2	1.494
3	6.634
4	1.166
5	29.870
6	1.823
7	1.031
8	0.275
9	0.508

1.2.5 Loss TimeWarpCosts

1.2.5.1 ObsNr 1

Task 2: TimeWarpCosts-Loss (obsNr: 1)

truthNr	Trivial
1	23.991
2	258.037
3	63.906
4	203.504
5	1.906
6	271.361
7	48.864
8	58.977
9	49.100

1.2.5.2 ObsNr 5

Task 2: TimeWarpCosts-Loss (obsNr: 5)

truthNr	Trivial
1	69.259
2	499.500
3	499.500
4	485.122
5	362.270
6	499.500
7	20.943
8	12.814
9	499.500

1.2.6 Loss stateDistriW2

1.2.6.1 ObsNr 1

Task 2: stateDistriW2-Loss (obsNr: 1)

truthNr	Trivial
1	0
2	0
3	0
4	0
5	0
6	0
7	0
8	0
9	0

1.2.6.2 ObsNr 5

Task 2: stateDistriW2-Loss (obsNr: 5)

truthNr	Trivial
1	0
2	0
3	0
4	0
5	0
6	0
7	0
8	0
9	0

2 Plots

plots <- 
  map(params$estiPlotsFiles, readRDS) |> 
  reduce(bind_rows) |> 
  pivot_longer(-c(method, ends_with("Nr")), names_to="plot")
  
for (tnr in unique(plots$taskNr)) {
  cat("## Task", tnr, "\n")
  taskPlots <- filter(plots, taskNr == tnr)
  for (onr in unique(taskPlots$obsNr)) {
    cat("### ObsNr", onr, "\n")
    obsPlots <- filter(taskPlots, obsNr == onr)
    for (kind in unique(obsPlots$plot)) {
      cat("#### Plots", kind, "\n\n\n")
      kindPlots <- filter(obsPlots, plot == kind) |> arrange(truthNr, method)
      # TODO: create layoutMatrix
      plt <- gridExtra::arrangeGrob(
        grobs = kindPlots$value, 
        layout_matrix = matrix(
          seq_len(nrow(kindPlots)), 
          ncol = length(unique(kindPlots$method)))) 
      plot(plt)
      cat("\n\n\n")
    }
  }
}

2.1 Task 1

2.1.1 ObsNr 1

2.1.1.1 Plots stateSpace

2.1.1.2 Plots timeDependence

2.1.1.3 Plots timeDependenceWarped

## Warning: Removed 16 row(s) containing missing values (geom_path).

## Warning: Removed 222 row(s) containing missing values (geom_path).

## Warning: Removed 82 row(s) containing missing values (geom_path).

## Warning: Removed 28 row(s) containing missing values (geom_path).

2.1.1.4 Plots timeDiff

2.1.2 ObsNr 5

2.1.2.1 Plots stateSpace

2.1.2.2 Plots timeDependence

2.1.2.3 Plots timeDependenceWarped

## Warning: Removed 24 row(s) containing missing values (geom_path).

## Warning: Removed 16 row(s) containing missing values (geom_path).

2.1.2.4 Plots timeDiff

2.2 Task 2

2.2.1 ObsNr 1

2.2.1.1 Plots stateSpace

2.2.1.2 Plots timeDependence

2.2.1.3 Plots timeDependenceWarped

## Warning: Removed 14 row(s) containing missing values (geom_path).

## Warning: Removed 202 row(s) containing missing values (geom_path).

2.2.1.4 Plots timeDiff

2.2.2 ObsNr 5

2.2.2.1 Plots stateSpace

2.2.2.2 Plots timeDependence

2.2.2.3 Plots timeDependenceWarped

## Warning: Removed 56 row(s) containing missing values (geom_path).

## Warning: Removed 52 row(s) containing missing values (geom_path).

2.2.2.4 Plots timeDiff